home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Fast_File_2121227202008.psc / File transfer / CommandXP.ctl
Text File  |  2007-01-28  |  72KB  |  2,081 lines
  1. VERSION 5.00
  2. Begin VB.UserControl CommandXP 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4800
  8.    DefaultCancel   =   -1  'True
  9.    ScaleHeight     =   240
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   320
  12.    Begin VB.Timer OverTimer 
  13.       Enabled         =   0   'False
  14.       Interval        =   3
  15.       Left            =   0
  16.       Top             =   0
  17.    End
  18. End
  19. Attribute VB_Name = "CommandXP"
  20. Attribute VB_GlobalNameSpace = False
  21. Attribute VB_Creatable = True
  22. Attribute VB_PredeclaredId = False
  23. Attribute VB_Exposed = False
  24. Option Explicit
  25.  
  26. #Const isOCX = False
  27.  
  28. Private Const cbVersion As String = "2.0.6 B"
  29.  
  30. Private Declare Function SetPixel Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  31. Private Declare Function GetNearestColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  32.  
  33. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  34. Private Const COLOR_HIGHLIGHT = 13
  35. Private Const COLOR_BTNFACE = 15
  36. Private Const COLOR_BTNSHADOW = 16
  37. Private Const COLOR_BTNTEXT = 18
  38. Private Const COLOR_BTNHIGHLIGHT = 20
  39. Private Const COLOR_BTNDKSHADOW = 21
  40. Private Const COLOR_BTNLIGHT = 22
  41.  
  42. Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
  43. Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
  44. Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
  45. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  46. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  47. Private Const DT_CALCRECT = &H400
  48. Private Const DT_WORDBREAK = &H10
  49. Private Const DT_CENTER = &H1 Or DT_WORDBREAK Or &H4
  50.  
  51. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  52. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  53. Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  54. Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
  55. Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  56.  
  57. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  58. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  59.  
  60. Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  61. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  62. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  63. Private Const PS_SOLID = 0
  64.  
  65. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  66. Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  67. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  68. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  69. Private Const RGN_DIFF = 4
  70.  
  71. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  72. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  73. Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
  74. Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
  75. Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long
  76.  
  77. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  78. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  79.  
  80. Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
  81.  
  82. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  83. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  84. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  85.  
  86. Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
  87. Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
  88.  
  89. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  90. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  91. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  92. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  93. Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
  94. Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  95. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  96.  
  97. Private Type RECT
  98.     Left As Long
  99.     Top As Long
  100.     Right As Long
  101.     Bottom As Long
  102. End Type
  103.  
  104. Private Type POINTAPI
  105.     X As Long
  106.     Y As Long
  107. End Type
  108.  
  109. Private Type BITMAPINFOHEADER
  110.     biSize As Long
  111.     biWidth As Long
  112.     biHeight As Long
  113.     biPlanes As Integer
  114.     biBitCount As Integer
  115.     biCompression As Long
  116.     biSizeImage As Long
  117.     biXPelsPerMeter As Long
  118.     biYPelsPerMeter As Long
  119.     biClrUsed As Long
  120.     biClrImportant As Long
  121. End Type
  122.  
  123. Private Type RGBTRIPLE
  124.     rgbBlue As Byte
  125.     rgbGreen As Byte
  126.     rgbRed As Byte
  127. End Type
  128.  
  129. Private Type BITMAPINFO
  130.     bmiHeader As BITMAPINFOHEADER
  131.     bmiColors As RGBTRIPLE
  132. End Type
  133.  
  134. Public Enum ButtonTypes
  135.     [Windows 16-bit] = 1    'the old-fashioned Win16 button
  136.     [Windows 32-bit] = 2    'the classic windows button
  137.     [Windows XP] = 3        'the new brand XP button totally owner-drawn
  138.     [Mac] = 4               'i suppose it looks exactly as a Mac button... i took the style from a GetRight skin!!!
  139.     [Java metal] = 5        'there are also other styles but not so different from windows one
  140.     [Netscape 6] = 6        'this is the button displayed in web-pages, it also appears in some java apps
  141.     [Simple Flat] = 7       'the standard flat button seen on toolbars
  142.     [Flat Highlight] = 8    'again the flat button but this one has no border until the mouse is over it
  143.     [Office XP] = 9         'the new Office XP button
  144.     '[MacOS-X] = 10         'this is a plan for the future...
  145.     [Transparent] = 11      'suggested from a user...
  146.     [3D Hover] = 12         'took this one from "Noteworthy Composer" toolbal
  147.     [Oval Flat] = 13        'a simple Oval Button
  148.     [KDE 2] = 14            'the great standard KDE2 button!
  149. End Enum
  150.  
  151. Public Enum ColorTypes
  152.     [Use Windows] = 1
  153.     [Custom] = 2
  154.     [Force Standard] = 3
  155.     [Use Container] = 4
  156. End Enum
  157.  
  158. Public Enum PicPositions
  159.     cbLeft = 0
  160.     cbRight = 1
  161.     cbTop = 2
  162.     cbBottom = 3
  163.     cbBackground = 4
  164. End Enum
  165.  
  166. Public Enum fx
  167.     cbNone = 0
  168.     cbEmbossed = 1
  169.     cbEngraved = 2
  170.     cbShadowed = 3
  171. End Enum
  172.  
  173. Private Const FXDEPTH As Long = &H28
  174.  
  175. 'events
  176. Public Event Click()
  177. Attribute Click.VB_UserMemId = -600
  178. Attribute Click.VB_MemberFlags = "200"
  179. Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  180. Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  181. Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  182. Public Event KeyPress(KeyAscii As Integer)
  183. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  184. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  185. Public Event MouseOver()
  186. Public Event MouseOut()
  187.  
  188. 'variables
  189. Private MyButtonType As ButtonTypes
  190. Private MyColorType As ColorTypes
  191. Private PicPosition As PicPositions
  192. Private SFX As fx 'font and picture effects
  193.  
  194. Private He As Long  'the height of the button
  195. Private Wi As Long  'the width of the button
  196.  
  197. Private BackC As Long 'back color
  198. Private BackO As Long 'back color when mouse is over
  199. Private ForeC As Long 'fore color
  200. Private ForeO As Long 'fore color when mouse is over
  201. Private MaskC As Long 'mask color
  202. Private OXPb As Long, OXPf As Long
  203. Private useMask As Boolean, useGrey As Boolean
  204. Private useHand As Boolean
  205.  
  206. Private picNormal As StdPicture, picHover As StdPicture
  207. Private pDC As Long, pBM As Long, oBM As Long 'used for the treansparent button
  208.  
  209. Private elTex As String     'current text
  210.  
  211. Private rc As RECT, rc2 As RECT, rc3 As RECT, fc As POINTAPI 'text and focus rect locations
  212. Private picPT As POINTAPI, picSZ As POINTAPI  'picture Position & Size
  213. Private rgnNorm As Long
  214.  
  215. Private LastButton As Byte, LastKeyDown As Byte
  216. Private isEnabled As Boolean, isSoft As Boolean
  217. Private HasFocus As Boolean, showFocusR As Boolean
  218.  
  219. Private cFace As Long, cLight As Long, cHighLight As Long, cShadow As Long, cDarkShadow As Long, cText As Long, cTextO As Long, cFaceO As Long, cMask As Long, XPFace As Long
  220.  
  221. Private lastStat As Byte, TE As String, isShown As Boolean  'used to avoid unnecessary repaints
  222. Private isOver As Boolean, inLoop As Boolean
  223.  
  224. Private Locked As Boolean
  225.  
  226. Private captOpt As Long
  227. Private isCheckbox As Boolean, cValue As Boolean
  228.  
  229. Private Sub OverTimer_Timer()
  230.  
  231.     If Not isMouseOver Then
  232.         OverTimer.Enabled = False
  233.         isOver = False
  234.         Call Redraw(0, True)
  235.         RaiseEvent MouseOut
  236.     End If
  237.  
  238. End Sub
  239.  
  240. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  241.  
  242.     LastButton = 1
  243.     Call UserControl_Click
  244.  
  245. End Sub
  246.  
  247. Private Sub UserControl_AmbientChanged(PropertyName As String)
  248.  
  249.     Call SetColors
  250.     Call Redraw(lastStat, True)
  251.  
  252. End Sub
  253.  
  254. Private Sub UserControl_Click()
  255.  
  256.     If LastButton = 1 And isEnabled Then
  257.         If isCheckbox Then cValue = Not cValue
  258.         Call Redraw(0, True) 'be sure that the normal status is drawn
  259.         UserControl.Refresh
  260.         RaiseEvent Click
  261.     End If
  262.  
  263. End Sub
  264.  
  265. Private Sub UserControl_DblClick()
  266.  
  267.     If LastButton = 1 Then
  268.         Call UserControl_MouseDown(1, 0, 0, 0)
  269.         SetCapture hwnd
  270.     End If
  271.  
  272. End Sub
  273.  
  274. Private Sub UserControl_GotFocus()
  275.  
  276.     HasFocus = True
  277.     Call Redraw(lastStat, True)
  278.  
  279. End Sub
  280.  
  281. Private Sub UserControl_Hide()
  282.  
  283.     isShown = False
  284.  
  285. End Sub
  286.  
  287. Private Sub UserControl_Initialize()
  288.  
  289. 'this makes the control to be slow, remark this line if the "not redrawing" problem is not important for you: ie, you intercept the Load_Event (with breakpoint or messageBox) and the button does not repaint...
  290.  
  291.     isShown = True
  292.  
  293. End Sub
  294.  
  295. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  296.  
  297.     RaiseEvent KeyDown(KeyCode, Shift)
  298.  
  299.     LastKeyDown = KeyCode
  300.     Select Case KeyCode
  301.     Case 32 'spacebar pressed
  302.         Call Redraw(2, False)
  303.     Case 39, 40 'right and down arrows
  304.         SendKeys "{Tab}"
  305.     Case 37, 38 'left and up arrows
  306.         SendKeys "+{Tab}"
  307.     End Select
  308.  
  309. End Sub
  310.  
  311. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  312.  
  313.     RaiseEvent KeyPress(KeyAscii)
  314.  
  315. End Sub
  316.  
  317. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  318.  
  319.     RaiseEvent KeyUp(KeyCode, Shift)
  320.  
  321.     If (KeyCode = 32) And (LastKeyDown = 32) Then 'spacebar pressed, and not cancelled by the user
  322.         If isCheckbox Then cValue = Not cValue
  323.         Call Redraw(0, False)
  324.         UserControl.Refresh
  325.         RaiseEvent Click
  326.     End If
  327.  
  328. End Sub
  329.  
  330. Private Sub UserControl_LostFocus()
  331.  
  332.     HasFocus = False
  333.     Call Redraw(lastStat, True)
  334.  
  335. End Sub
  336.  
  337. Private Sub UserControl_InitProperties()
  338.  
  339.     isEnabled = True: showFocusR = True: useMask = True
  340.     elTex = Ambient.DisplayName
  341.     Set UserControl.Font = Ambient.Font
  342.     MyButtonType = [Windows 32-bit]
  343.     MyColorType = [Use Windows]
  344.     Call SetColors
  345.     BackC = cFace: BackO = BackC
  346.     ForeC = cText: ForeO = ForeC
  347.     MaskC = &HC0C0C0
  348.     Call CalcTextRects
  349.  
  350. End Sub
  351.  
  352. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  353.  
  354.     RaiseEvent MouseDown(Button, Shift, X, Y)
  355.     LastButton = Button
  356.     If Button <> 2 Then Call Redraw(2, False)
  357.  
  358. End Sub
  359.  
  360. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  361.  
  362.     RaiseEvent MouseMove(Button, Shift, X, Y)
  363.     If Button < 2 Then
  364.         If Not isMouseOver Then
  365.             'we are outside the button
  366.             Call Redraw(0, False)
  367.         Else
  368.             'we are inside the button
  369.             If Button = 0 And Not isOver Then
  370.                 OverTimer.Enabled = True
  371.                 isOver = True
  372.                 Call Redraw(0, True)
  373.                 RaiseEvent MouseOver
  374.             ElseIf Button = 1 Then
  375.                 isOver = True
  376.                 Call Redraw(2, False)
  377.                 isOver = False
  378.             End If
  379.         End If
  380.     End If
  381.  
  382. End Sub
  383.  
  384. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  385.  
  386.     RaiseEvent MouseUp(Button, Shift, X, Y)
  387.     If Button <> 2 Then Call Redraw(0, False)
  388.  
  389. End Sub
  390.  
  391. '########## BUTTON PROPERTIES ##########
  392. Public Property Get BackColor() As OLE_COLOR
  393. Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
  394. Attribute BackColor.VB_UserMemId = -501
  395.  
  396.     BackColor = BackC
  397.  
  398. End Property
  399.  
  400. Public Property Let BackColor(ByVal theCol As OLE_COLOR)
  401.  
  402.     BackC = theCol
  403.     If Not Ambient.UserMode Then BackO = theCol
  404.     Call SetColors
  405.     Call Redraw(lastStat, True)
  406.     PropertyChanged "BCOL"
  407.  
  408. End Property
  409.  
  410. Public Property Get BackOver() As OLE_COLOR
  411. Attribute BackOver.VB_ProcData.VB_Invoke_Property = ";Appearance"
  412.  
  413.     BackOver = BackO
  414.  
  415. End Property
  416.  
  417. Public Property Let BackOver(ByVal theCol As OLE_COLOR)
  418.  
  419.     BackO = theCol
  420.     Call SetColors
  421.     Call Redraw(lastStat, True)
  422.     PropertyChanged "BCOLO"
  423.  
  424. End Property
  425.  
  426. Public Property Get ForeColor() As OLE_COLOR
  427. Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
  428. Attribute ForeColor.VB_UserMemId = -513
  429.  
  430.     ForeColor = ForeC
  431.  
  432. End Property
  433.  
  434. Public Property Let ForeColor(ByVal theCol As OLE_COLOR)
  435.  
  436.     ForeC = theCol
  437.     If Not Ambient.UserMode Then ForeO = theCol
  438.     Call SetColors
  439.     Call Redraw(lastStat, True)
  440.     PropertyChanged "FCOL"
  441.  
  442. End Property
  443.  
  444. Public Property Get ForeOver() As OLE_COLOR
  445. Attribute ForeOver.VB_ProcData.VB_Invoke_Property = ";Appearance"
  446.  
  447.     ForeOver = ForeO
  448.  
  449. End Property
  450.  
  451. Public Property Let ForeOver(ByVal theCol As OLE_COLOR)
  452.  
  453.     ForeO = theCol
  454.     Call SetColors
  455.     Call Redraw(lastStat, True)
  456.     PropertyChanged "FCOLO"
  457.  
  458. End Property
  459.  
  460. Public Property Get MaskColor() As OLE_COLOR
  461. Attribute MaskColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
  462.  
  463.     MaskColor = MaskC
  464.  
  465. End Property
  466.  
  467. Public Property Let MaskColor(ByVal theCol As OLE_COLOR)
  468.  
  469.     MaskC = theCol
  470.     Call SetColors
  471.     Call Redraw(lastStat, True)
  472.     PropertyChanged "MCOL"
  473.  
  474. End Property
  475.  
  476. Public Property Get ButtonType() As ButtonTypes
  477. Attribute ButtonType.VB_ProcData.VB_Invoke_Property = ";Appearance"
  478.  
  479.     ButtonType = MyButtonType
  480.  
  481. End Property
  482.  
  483. Public Property Let ButtonType(ByVal newValue As ButtonTypes)
  484.  
  485.     MyButtonType = newValue
  486.     If MyButtonType = [Java metal] And Not Ambient.UserMode Then
  487.         UserControl.FontBold = True
  488.     ElseIf MyButtonType = 11 And isShown Then
  489.         Call GetParentPic
  490.     End If
  491.     Call UserControl_Resize
  492.     PropertyChanged "BTYPE"
  493.  
  494. End Property
  495.  
  496. Public Property Get Caption() As String
  497. Attribute Caption.VB_ProcData.VB_Invoke_Property = ";Text"
  498. Attribute Caption.VB_UserMemId = -518
  499.  
  500.     Caption = elTex
  501.  
  502. End Property
  503.  
  504. Public Property Let Caption(ByVal newValue As String)
  505.  
  506.     elTex = newValue
  507.     Call SetAccessKeys
  508.     Call CalcTextRects
  509.     Call Redraw(0, True)
  510.     PropertyChanged "TX"
  511.  
  512. End Property
  513.  
  514. Public Property Get Enabled() As Boolean
  515. Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
  516. Attribute Enabled.VB_UserMemId = -514
  517.  
  518.     Enabled = isEnabled
  519.  
  520. End Property
  521.  
  522. Public Property Let Enabled(ByVal newValue As Boolean)
  523.  
  524.     isEnabled = newValue
  525.     Call Redraw(0, True)
  526.     UserControl.Enabled = isEnabled
  527.     PropertyChanged "ENAB"
  528.  
  529. End Property
  530.  
  531. Public Property Get Font() As Font
  532. Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
  533. Attribute Font.VB_UserMemId = -512
  534.  
  535.     Set Font = UserControl.Font
  536.  
  537. End Property
  538.  
  539. Public Property Set Font(ByRef newFont As Font)
  540.  
  541.     Set UserControl.Font = newFont
  542.     Call CalcTextRects
  543.     Call Redraw(0, True)
  544.     PropertyChanged "FONT"
  545.  
  546. End Property
  547.  
  548. Public Property Get FontBold() As Boolean
  549. Attribute FontBold.VB_MemberFlags = "400"
  550.  
  551.     FontBold = UserControl.FontBold
  552.  
  553. End Property
  554.  
  555. Public Property Let FontBold(ByVal newValue As Boolean)
  556.  
  557.     UserControl.FontBold = newValue
  558.     Call CalcTextRects
  559.     Call Redraw(0, True)
  560.  
  561. End Property
  562.  
  563. Public Property Get FontItalic() As Boolean
  564. Attribute FontItalic.VB_MemberFlags = "400"
  565.  
  566.     FontItalic = UserControl.FontItalic
  567.  
  568. End Property
  569.  
  570. Public Property Let FontItalic(ByVal newValue As Boolean)
  571.  
  572.     UserControl.FontItalic = newValue
  573.     Call CalcTextRects
  574.     Call Redraw(0, True)
  575.  
  576. End Property
  577.  
  578. Public Property Get FontUnderline() As Boolean
  579. Attribute FontUnderline.VB_MemberFlags = "400"
  580.  
  581.     FontUnderline = UserControl.FontUnderline
  582.  
  583. End Property
  584.  
  585. Public Property Let FontUnderline(ByVal newValue As Boolean)
  586.  
  587.     UserControl.FontUnderline = newValue
  588.     Call CalcTextRects
  589.     Call Redraw(0, True)
  590.  
  591. End Property
  592.  
  593. Public Property Get FontSize() As Integer
  594. Attribute FontSize.VB_MemberFlags = "400"
  595.  
  596.     FontSize = UserControl.FontSize
  597.  
  598. End Property
  599.  
  600. Public Property Let FontSize(ByVal newValue As Integer)
  601.  
  602.     UserControl.FontSize = newValue
  603.     Call CalcTextRects
  604.     Call Redraw(0, True)
  605.  
  606. End Property
  607.  
  608. Public Property Get FontName() As String
  609. Attribute FontName.VB_MemberFlags = "400"
  610.  
  611.     FontName = UserControl.FontName
  612.  
  613. End Property
  614.  
  615. Public Property Let FontName(ByVal newValue As String)
  616.  
  617.     UserControl.FontName = newValue
  618.     Call CalcTextRects
  619.     Call Redraw(0, True)
  620.  
  621. End Property
  622.  
  623. 'it is very common that a windows user uses custom color
  624. 'schemes to view his/her desktop, and is also very
  625. 'common that this color scheme has weird colors that
  626. 'would alter the nice look of my buttons.
  627. 'So if you want to force the button to use the windows
  628. 'standard colors you may change this property to "Force Standard"
  629.  
  630. Public Property Get ColorScheme() As ColorTypes
  631. Attribute ColorScheme.VB_ProcData.VB_Invoke_Property = ";Appearance"
  632.  
  633.     ColorScheme = MyColorType
  634.  
  635. End Property
  636.  
  637. Public Property Let ColorScheme(ByVal newValue As ColorTypes)
  638.  
  639.     MyColorType = newValue
  640.     Call SetColors
  641.     Call Redraw(0, True)
  642.     PropertyChanged "COLTYPE"
  643.  
  644. End Property
  645.  
  646. Public Property Get ShowFocusRect() As Boolean
  647. Attribute ShowFocusRect.VB_ProcData.VB_Invoke_Property = ";Appearance"
  648.  
  649.     ShowFocusRect = showFocusR
  650.  
  651. End Property
  652.  
  653. Public Property Let ShowFocusRect(ByVal newValue As Boolean)
  654.  
  655.     showFocusR = newValue
  656.     Call Redraw(lastStat, True)
  657.     PropertyChanged "FOCUSR"
  658.  
  659. End Property
  660.  
  661. Public Property Get MousePointer() As MousePointerConstants
  662. Attribute MousePointer.VB_ProcData.VB_Invoke_Property = ";Appearance"
  663.  
  664.     MousePointer = UserControl.MousePointer
  665.  
  666. End Property
  667.  
  668. Public Property Let MousePointer(ByVal newPointer As MousePointerConstants)
  669.  
  670.     UserControl.MousePointer = newPointer
  671.     PropertyChanged "MPTR"
  672.  
  673. End Property
  674.  
  675. Public Property Get MouseIcon() As StdPicture
  676. Attribute MouseIcon.VB_ProcData.VB_Invoke_Property = ";Appearance"
  677.  
  678.     Set MouseIcon = UserControl.MouseIcon
  679.  
  680. End Property
  681.  
  682. Public Property Set MouseIcon(ByVal newIcon As StdPicture)
  683.  
  684.     On Local Error Resume Next
  685.         Set UserControl.MouseIcon = newIcon
  686.         PropertyChanged "MICON"
  687.     On Error GoTo 0
  688.  
  689. End Property
  690.  
  691. Public Property Get HandPointer() As Boolean
  692.  
  693.     HandPointer = useHand
  694.  
  695. End Property
  696.  
  697. Public Property Let HandPointer(ByVal newVal As Boolean)
  698.  
  699.     useHand = newVal
  700.     If useHand Then
  701.         Set UserControl.MouseIcon = LoadResPicture(101, 2)
  702.         UserControl.MousePointer = 99
  703.     Else
  704.         Set UserControl.MouseIcon = Nothing
  705.         UserControl.MousePointer = 1
  706.     End If
  707.     PropertyChanged "HAND"
  708.  
  709. End Property
  710.  
  711. Public Property Get hwnd() As Long
  712. Attribute hwnd.VB_UserMemId = -515
  713.  
  714.     hwnd = UserControl.hwnd
  715.  
  716. End Property
  717.  
  718. Public Property Get SoftBevel() As Boolean
  719. Attribute SoftBevel.VB_ProcData.VB_Invoke_Property = ";Appearance"
  720.  
  721.     SoftBevel = isSoft
  722.  
  723. End Property
  724.  
  725. Public Property Let SoftBevel(ByVal newValue As Boolean)
  726.  
  727.     isSoft = newValue
  728.     Call SetColors
  729.     Call Redraw(lastStat, True)
  730.     PropertyChanged "SOFT"
  731.  
  732. End Property
  733.  
  734. Public Property Get PictureNormal() As StdPicture
  735. Attribute PictureNormal.VB_ProcData.VB_Invoke_Property = ";Appearance"
  736.  
  737.     Set PictureNormal = picNormal
  738.  
  739. End Property
  740.  
  741. Public Property Set PictureNormal(ByVal newPic As StdPicture)
  742.  
  743.     Set picNormal = newPic
  744.     Call CalcPicSize
  745.     Call CalcTextRects
  746.     Call Redraw(lastStat, True)
  747.     PropertyChanged "PICN"
  748.  
  749. End Property
  750.  
  751. Public Property Get PictureOver() As StdPicture
  752. Attribute PictureOver.VB_ProcData.VB_Invoke_Property = ";Appearance"
  753.  
  754.     Set PictureOver = picHover
  755.  
  756. End Property
  757.  
  758. Public Property Set PictureOver(ByVal newPic As StdPicture)
  759.  
  760.     Set picHover = newPic
  761.     If isOver Then Call Redraw(lastStat, True) 'only redraw i we need to see this picture immediately
  762.     PropertyChanged "PICO"
  763.  
  764. End Property
  765.  
  766. Public Property Get PicturePosition() As PicPositions
  767. Attribute PicturePosition.VB_ProcData.VB_Invoke_Property = ";Position"
  768.  
  769.     PicturePosition = PicPosition
  770.  
  771. End Property
  772.  
  773. Public Property Let PicturePosition(ByVal newPicPos As PicPositions)
  774.  
  775.     PicPosition = newPicPos
  776.     PropertyChanged "PICPOS"
  777.     Call CalcTextRects
  778.     Call Redraw(lastStat, True)
  779.  
  780. End Property
  781.  
  782. Public Property Get UseMaskColor() As Boolean
  783. Attribute UseMaskColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
  784.  
  785.     UseMaskColor = useMask
  786.  
  787. End Property
  788.  
  789. Public Property Let UseMaskColor(ByVal newValue As Boolean)
  790.  
  791.     useMask = newValue
  792.     If Not picNormal Is Nothing Then Call Redraw(lastStat, True)
  793.     PropertyChanged "UMCOL"
  794.  
  795. End Property
  796.  
  797. Public Property Get UseGreyscale() As Boolean
  798. Attribute UseGreyscale.VB_ProcData.VB_Invoke_Property = ";Appearance"
  799.  
  800.     UseGreyscale = useGrey
  801.  
  802. End Property
  803.  
  804. Public Property Let UseGreyscale(ByVal newValue As Boolean)
  805.  
  806.     useGrey = newValue
  807.     If Not picNormal Is Nothing Then Call Redraw(lastStat, True)
  808.     PropertyChanged "NGREY"
  809.  
  810. End Property
  811.  
  812. Public Property Get SpecialEffect() As fx
  813. Attribute SpecialEffect.VB_ProcData.VB_Invoke_Property = ";Appearance"
  814.  
  815.     SpecialEffect = SFX
  816.  
  817. End Property
  818.  
  819. Public Property Let SpecialEffect(ByVal newValue As fx)
  820.  
  821.     SFX = newValue
  822.     Call Redraw(lastStat, True)
  823.     PropertyChanged "FX"
  824.  
  825. End Property
  826.  
  827. Public Property Get CheckBoxBehaviour() As Boolean
  828.  
  829.     CheckBoxBehaviour = isCheckbox
  830.  
  831. End Property
  832.  
  833. Public Property Let CheckBoxBehaviour(ByVal newValue As Boolean)
  834.  
  835.     isCheckbox = newValue
  836.     Call Redraw(lastStat, True)
  837.     PropertyChanged "CHECK"
  838.  
  839. End Property
  840.  
  841. Public Property Get Value() As Boolean
  842.  
  843.     Value = cValue
  844.  
  845. End Property
  846.  
  847. Public Property Let Value(ByVal newValue As Boolean)
  848.  
  849.     cValue = newValue
  850.     If isCheckbox Then Call Redraw(0, True)
  851.     PropertyChanged "VALUE"
  852.  
  853. End Property
  854.  
  855. Public Property Get Version() As String
  856. Attribute Version.VB_MemberFlags = "40"
  857.  
  858.     Version = cbVersion
  859.  
  860. End Property
  861.  
  862. '########## END OF PROPERTIES ##########
  863.  
  864. Private Sub UserControl_Resize()
  865.  
  866.     If inLoop Then Exit Sub
  867.     'get button size
  868.     GetClientRect UserControl.hwnd, rc3
  869.     'assign these values to He and Wi
  870.     He = rc3.Bottom: Wi = rc3.Right
  871.     'build the FocusRect size and position depending on the button type
  872.     If MyButtonType >= [Simple Flat] And MyButtonType <= [Oval Flat] Then
  873.         InflateRect rc3, -3, -3
  874.     ElseIf MyButtonType = [KDE 2] Then
  875.         InflateRect rc3, -5, -5
  876.         OffsetRect rc3, 1, 1
  877.     Else
  878.         InflateRect rc3, -4, -4
  879.     End If
  880.     Call CalcTextRects
  881.  
  882.     If rgnNorm Then DeleteObject rgnNorm
  883.     Call MakeRegion
  884.     SetWindowRgn UserControl.hwnd, rgnNorm, True
  885.  
  886.     If He Then Call Redraw(0, True)
  887.  
  888. End Sub
  889.  
  890. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  891.  
  892.     With PropBag
  893.         MyButtonType = .ReadProperty("BTYPE", 2)
  894.         elTex = .ReadProperty("TX", "")
  895.         isEnabled = .ReadProperty("ENAB", True)
  896.         Set UserControl.Font = .ReadProperty("FONT", UserControl.Font)
  897.         MyColorType = .ReadProperty("COLTYPE", 1)
  898.         showFocusR = .ReadProperty("FOCUSR", True)
  899.         BackC = .ReadProperty("BCOL", GetSysColor(COLOR_BTNFACE))
  900.         BackO = .ReadProperty("BCOLO", BackC)
  901.         ForeC = .ReadProperty("FCOL", GetSysColor(COLOR_BTNTEXT))
  902.         ForeO = .ReadProperty("FCOLO", ForeC)
  903.         MaskC = .ReadProperty("MCOL", &HC0C0C0)
  904.         UserControl.MousePointer = .ReadProperty("MPTR", 0)
  905.         Set UserControl.MouseIcon = .ReadProperty("MICON", Nothing)
  906.         Set picNormal = .ReadProperty("PICN", Nothing)
  907.         Set picHover = .ReadProperty("PICH", Nothing)
  908.         useMask = .ReadProperty("UMCOL", True)
  909.         isSoft = .ReadProperty("SOFT", False)
  910.         PicPosition = .ReadProperty("PICPOS", 0)
  911.         useGrey = .ReadProperty("NGREY", False)
  912.         SFX = .ReadProperty("FX", 0)
  913.         Me.HandPointer = .ReadProperty("HAND", False)
  914.         isCheckbox = .ReadProperty("CHECK", False)
  915.         cValue = .ReadProperty("VALUE", False)
  916.     End With
  917.  
  918.     UserControl.Enabled = isEnabled
  919.     Call CalcPicSize
  920.     Call CalcTextRects
  921.     Call SetAccessKeys
  922.  
  923. End Sub
  924.  
  925. Private Sub UserControl_Show()
  926.  
  927.     If MyButtonType = 11 Then
  928.         If pDC = 0 Then
  929.             pDC = CreateCompatibleDC(UserControl.hdc): pBM = CreateBitmap(Wi, He, 1, GetDeviceCaps(hdc, 12), ByVal 0&)
  930.             oBM = SelectObject(pDC, pBM)
  931.         End If
  932.  
  933.         Call GetParentPic
  934.     End If
  935.  
  936.     isShown = True
  937.     Call SetColors
  938.     Call Redraw(0, True)
  939.  
  940. End Sub
  941.  
  942. Private Sub UserControl_Terminate()
  943.  
  944.     isShown = False
  945.     DeleteObject rgnNorm
  946.     If pDC Then
  947.         DeleteObject SelectObject(pDC, oBM)
  948.         DeleteDC pDC
  949.     End If
  950.  
  951. End Sub
  952.  
  953. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  954.  
  955.     With PropBag
  956.         Call .WriteProperty("BTYPE", MyButtonType)
  957.         Call .WriteProperty("TX", elTex)
  958.         Call .WriteProperty("ENAB", isEnabled)
  959.         Call .WriteProperty("FONT", UserControl.Font)
  960.         Call .WriteProperty("COLTYPE", MyColorType)
  961.         Call .WriteProperty("FOCUSR", showFocusR)
  962.         Call .WriteProperty("BCOL", BackC)
  963.         Call .WriteProperty("BCOLO", BackO)
  964.         Call .WriteProperty("FCOL", ForeC)
  965.         Call .WriteProperty("FCOLO", ForeO)
  966.         Call .WriteProperty("MCOL", MaskC)
  967.         Call .WriteProperty("MPTR", UserControl.MousePointer)
  968.         Call .WriteProperty("MICON", UserControl.MouseIcon)
  969.         Call .WriteProperty("PICN", picNormal)
  970.         Call .WriteProperty("PICH", picHover)
  971.         Call .WriteProperty("UMCOL", useMask)
  972.         Call .WriteProperty("SOFT", isSoft)
  973.         Call .WriteProperty("PICPOS", PicPosition)
  974.         Call .WriteProperty("NGREY", useGrey)
  975.         Call .WriteProperty("FX", SFX)
  976.         Call .WriteProperty("HAND", useHand)
  977.         Call .WriteProperty("CHECK", isCheckbox)
  978.         Call .WriteProperty("VALUE", cValue)
  979.     End With
  980.  
  981. End Sub
  982.  
  983. Private Sub Redraw(ByVal curStat As Byte, ByVal Force As Boolean)
  984.  
  985. 'here is the CORE of the button, everything is drawn here
  986. 'it's not well commented but i think that everything is
  987. 'pretty self explanatory...
  988.  
  989.     If isCheckbox And cValue Then curStat = 2
  990.  
  991.     If Not Force Then  'check drawing redundancy
  992.         If (curStat = lastStat) And (TE = elTex) Then Exit Sub
  993.     End If
  994.  
  995.     If He = 0 Or Not isShown Then Exit Sub   'we don't want errors
  996.  
  997.     lastStat = curStat
  998.     TE = elTex
  999.  
  1000. Dim i As Long, stepXP1 As Single, XPFace2 As Long, tempCol As Long
  1001.  
  1002.     With UserControl
  1003.         .Cls
  1004.         If isOver And MyColorType = Custom Then tempCol = BackC: BackC = BackO: SetColors
  1005.  
  1006.         DrawRectangle 0, 0, Wi, He, cFace
  1007.  
  1008.         If isEnabled Then
  1009.             If curStat = 0 Then
  1010.                 '#@#@#@#@#@# BUTTON NORMAL STATE #@#@#@#@#@#
  1011.                 Select Case MyButtonType
  1012.                 Case 1 'Windows 16-bit
  1013.                     Call DrawCaption(Abs(isOver))
  1014.                     DrawFrame cHighLight, cShadow, cHighLight, cShadow, True
  1015.                     DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1016.                     Call DrawFocusR
  1017.                 Case 2 'Windows 32-bit
  1018.                     Call DrawCaption(Abs(isOver))
  1019.                     If Ambient.DisplayAsDefault And showFocusR Then
  1020.                         DrawFrame cHighLight, cDarkShadow, cLight, cShadow, True
  1021.                         Call DrawFocusR
  1022.                         DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1023.                     Else
  1024.                         DrawFrame cHighLight, cDarkShadow, cLight, cShadow, False
  1025.                     End If
  1026.                 Case 3 'Windows XP
  1027.                     stepXP1 = 25 / He
  1028.                     For i = 1 To He
  1029.                         DrawLine 0, i, Wi, i, ShiftColor(XPFace, -stepXP1 * i, True)
  1030.                     Next i
  1031.                     Call DrawCaption(Abs(isOver))
  1032.                     DrawRectangle 0, 0, Wi, He, &H733C00, True
  1033.                     mSetPixel 1, 1, &H7B4D10
  1034.                     mSetPixel 1, He - 2, &H7B4D10
  1035.                     mSetPixel Wi - 2, 1, &H7B4D10
  1036.                     mSetPixel Wi - 2, He - 2, &H7B4D10
  1037.  
  1038.                     If isOver Then
  1039.                         DrawRectangle 1, 2, Wi - 2, He - 4, &H31B2FF, True
  1040.                         DrawLine 2, He - 2, Wi - 2, He - 2, &H96E7&
  1041.                         DrawLine 2, 1, Wi - 2, 1, &HCEF3FF
  1042.                         DrawLine 1, 2, Wi - 1, 2, &H8CDBFF
  1043.                         DrawLine 2, 3, 2, He - 3, &H6BCBFF
  1044.                         DrawLine Wi - 3, 3, Wi - 3, He - 3, &H6BCBFF
  1045.                     ElseIf ((HasFocus Or Ambient.DisplayAsDefault) And showFocusR) Then
  1046.                         DrawRectangle 1, 2, Wi - 2, He - 4, &HE7AE8C, True
  1047.                         DrawLine 2, He - 2, Wi - 2, He - 2, &HEF826B
  1048.                         DrawLine 2, 1, Wi - 2, 1, &HFFE7CE
  1049.                         DrawLine 1, 2, Wi - 1, 2, &HF7D7BD
  1050.                         DrawLine 2, 3, 2, He - 3, &HF0D1B5
  1051.                         DrawLine Wi - 3, 3, Wi - 3, He - 3, &HF0D1B5
  1052.                     Else 'we do not draw the bevel always because the above code would repaint over it
  1053.                         DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPFace, -&H30, True)
  1054.                         DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPFace, -&H20, True)
  1055.                         DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPFace, -&H24, True)
  1056.                         DrawLine Wi - 3, 3, Wi - 3, He - 3, ShiftColor(XPFace, -&H18, True)
  1057.                         DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPFace, &H10, True)
  1058.                         DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPFace, &HA, True)
  1059.                         DrawLine 1, 2, 1, He - 2, ShiftColor(XPFace, -&H5, True)
  1060.                         DrawLine 2, 3, 2, He - 3, ShiftColor(XPFace, -&HA, True)
  1061.                     End If
  1062.                 Case 4 'Mac
  1063.                     DrawRectangle 1, 1, Wi - 2, He - 2, cLight
  1064.                     Call DrawCaption(Abs(isOver))
  1065.                     DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1066.                     mSetPixel 1, 1, cDarkShadow
  1067.                     mSetPixel 1, He - 2, cDarkShadow
  1068.                     mSetPixel Wi - 2, 1, cDarkShadow
  1069.                     mSetPixel Wi - 2, He - 2, cDarkShadow
  1070.                     DrawLine 1, 2, 2, 0, cFace
  1071.                     DrawLine 3, 2, Wi - 3, 2, cHighLight
  1072.                     DrawLine 2, 2, 2, He - 3, cHighLight
  1073.                     mSetPixel 3, 3, cHighLight
  1074.                     DrawLine Wi - 3, 1, Wi - 3, He - 3, cFace
  1075.                     DrawLine 1, He - 3, Wi - 3, He - 3, cFace
  1076.                     mSetPixel Wi - 4, He - 4, cFace
  1077.                     DrawLine Wi - 2, 2, Wi - 2, He - 2, cShadow
  1078.                     DrawLine 2, He - 2, Wi - 2, He - 2, cShadow
  1079.                     mSetPixel Wi - 3, He - 3, cShadow
  1080.                 Case 5 'Java
  1081.                     DrawRectangle 1, 1, Wi - 1, He - 1, ShiftColor(cFace, &HC)
  1082.                     Call DrawCaption(Abs(isOver))
  1083.                     DrawRectangle 1, 1, Wi - 1, He - 1, cHighLight, True
  1084.                     DrawRectangle 0, 0, Wi - 1, He - 1, ShiftColor(cShadow, -&H1A), True
  1085.                     mSetPixel 1, He - 2, ShiftColor(cShadow, &H1A)
  1086.                     mSetPixel Wi - 2, 1, ShiftColor(cShadow, &H1A)
  1087.                     If HasFocus And showFocusR Then DrawRectangle rc.Left - 2, rc.Top - 1, fc.X + 4, fc.Y + 2, &HCC9999, True
  1088.                 Case 6 'Netscape
  1089.                     Call DrawCaption(Abs(isOver))
  1090.                     DrawFrame ShiftColor(cLight, &H8), cShadow, ShiftColor(cLight, &H8), cShadow, False
  1091.                     Call DrawFocusR
  1092.                 Case 7, 8, 12 'Flat buttons
  1093.                     Call DrawCaption(Abs(isOver))
  1094.                     If (MyButtonType = [Simple Flat]) Then
  1095.                         DrawFrame cHighLight, cShadow, 0, 0, False, True
  1096.                     ElseIf isOver Then
  1097.                         If MyButtonType = [Flat Highlight] Then
  1098.                             DrawFrame cHighLight, cShadow, 0, 0, False, True
  1099.                         Else
  1100.                             DrawFrame cHighLight, cDarkShadow, cLight, cShadow, False, False
  1101.                         End If
  1102.                     End If
  1103.                     Call DrawFocusR
  1104.                 Case 9 'Office XP
  1105.                     If isOver Then DrawRectangle 1, 1, Wi, He, OXPf
  1106.                     Call DrawCaption(Abs(isOver))
  1107.                     If isOver Then DrawRectangle 0, 0, Wi, He, OXPb, True
  1108.                     Call DrawFocusR
  1109.                 Case 11 'transparent
  1110.                     BitBlt hdc, 0, 0, Wi, He, pDC, 0, 0, vbSrcCopy
  1111.                     Call DrawCaption(Abs(isOver))
  1112.                     Call DrawFocusR
  1113.                 Case 13 'Oval
  1114.                     DrawEllipse 0, 0, Wi, He, Abs(isOver) * cShadow + Abs(Not isOver) * cFace, cFace
  1115.                     Call DrawCaption(Abs(isOver))
  1116.                 Case 14 'KDE 2
  1117.                     Dim prevBold As Boolean
  1118.                     If Not isOver Then
  1119.                         stepXP1 = 58 / He
  1120.                         For i = 1 To He
  1121.                             DrawLine 0, i, Wi, i, ShiftColor(cHighLight, -stepXP1 * i)
  1122.                         Next i
  1123.                     Else
  1124.                         DrawRectangle 0, 0, Wi, He, cLight
  1125.                     End If
  1126.                     If Ambient.DisplayAsDefault Then isShown = False: prevBold = Me.FontBold: Me.FontBold = True
  1127.                     Call DrawCaption(Abs(isOver))
  1128.                     If Ambient.DisplayAsDefault Then Me.FontBold = prevBold: isShown = True
  1129.                     DrawRectangle 0, 0, Wi, He, ShiftColor(cShadow, -&H32), True
  1130.                     DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cFace, -&H9), True
  1131.                     DrawRectangle 2, 2, Wi - 4, 2, cHighLight
  1132.                     DrawRectangle 2, 4, 2, He - 6, cHighLight
  1133.                     Call DrawFocusR
  1134.                 End Select
  1135.                 Call DrawPictures(0)
  1136.             ElseIf curStat = 2 Then
  1137.                 '#@#@#@#@#@# BUTTON IS DOWN #@#@#@#@#@#
  1138.                 Select Case MyButtonType
  1139.                 Case 1 'Windows 16-bit
  1140.                     Call DrawCaption(2)
  1141.                     DrawFrame cShadow, cHighLight, cShadow, cHighLight, True
  1142.                     DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1143.                     Call DrawFocusR
  1144.                 Case 2 'Windows 32-bit
  1145.                     Call DrawCaption(2)
  1146.                     If showFocusR And Ambient.DisplayAsDefault Then
  1147.                         DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1148.                         DrawRectangle 1, 1, Wi - 2, He - 2, cShadow, True
  1149.                         Call DrawFocusR
  1150.                     Else
  1151.                         DrawFrame cDarkShadow, cHighLight, cShadow, cLight, False
  1152.                     End If
  1153.                 Case 3 'Windows XP
  1154.                     stepXP1 = 25 / He
  1155.                     XPFace2 = ShiftColor(XPFace, -32, True)
  1156.                     For i = 1 To He
  1157.                         DrawLine 0, He - i, Wi, He - i, ShiftColor(XPFace2, -stepXP1 * i, True)
  1158.                     Next i
  1159.                     Call DrawCaption(2)
  1160.                     DrawRectangle 0, 0, Wi, He, &H733C00, True
  1161.                     mSetPixel 1, 1, &H7B4D10
  1162.                     mSetPixel 1, He - 2, &H7B4D10
  1163.                     mSetPixel Wi - 2, 1, &H7B4D10
  1164.                     mSetPixel Wi - 2, He - 2, &H7B4D10
  1165.  
  1166.                     DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPFace2, &H10, True)
  1167.                     DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPFace2, &HA, True)
  1168.                     DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPFace2, &H5, True)
  1169.                     DrawLine Wi - 3, 3, Wi - 3, He - 3, XPFace
  1170.                     DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPFace2, -&H20, True)
  1171.                     DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPFace2, -&H18, True)
  1172.                     DrawLine 1, 2, 1, He - 2, ShiftColor(XPFace2, -&H20, True)
  1173.                     DrawLine 2, 2, 2, He - 2, ShiftColor(XPFace2, -&H16, True)
  1174.                 Case 4 'Mac
  1175.                     DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
  1176.                     XPFace = ShiftColor(cShadow, -&H10)
  1177.                     Call DrawCaption(2)
  1178.                     XPFace = ShiftColor(cFace, &H30)
  1179.                     DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1180.                     DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, -&H40), True
  1181.                     DrawRectangle 2, 2, Wi - 4, He - 4, ShiftColor(cShadow, -&H20), True
  1182.                     mSetPixel 2, 2, ShiftColor(cShadow, -&H40)
  1183.                     mSetPixel 3, 3, ShiftColor(cShadow, -&H20)
  1184.                     mSetPixel 1, 1, cDarkShadow
  1185.                     mSetPixel 1, He - 2, cDarkShadow
  1186.                     mSetPixel Wi - 2, 1, cDarkShadow
  1187.                     mSetPixel Wi - 2, He - 2, cDarkShadow
  1188.                     DrawLine Wi - 3, 1, Wi - 3, He - 3, cShadow
  1189.                     DrawLine 1, He - 3, Wi - 2, He - 3, cShadow
  1190.                     mSetPixel Wi - 4, He - 4, cShadow
  1191.                     DrawLine Wi - 2, 3, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
  1192.                     DrawLine 3, He - 2, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
  1193.                     DrawLine Wi - 2, He - 3, Wi - 4, He - 1, ShiftColor(cShadow, -&H20)
  1194.                     mSetPixel 2, He - 2, ShiftColor(cShadow, -&H20)
  1195.                     mSetPixel Wi - 2, 2, ShiftColor(cShadow, -&H20)
  1196.                 Case 5 'Java
  1197.                     DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, &H10), False
  1198.                     DrawRectangle 0, 0, Wi - 1, He - 1, ShiftColor(cShadow, -&H1A), True
  1199.                     DrawLine Wi - 1, 1, Wi - 1, He, cHighLight
  1200.                     DrawLine 1, He - 1, Wi - 1, He - 1, cHighLight
  1201.                     SetTextColor .hdc, cTextO
  1202.                     DrawText .hdc, elTex, Len(elTex), rc, DT_CENTER
  1203.                     If HasFocus And showFocusR Then DrawRectangle rc.Left - 2, rc.Top - 1, fc.X + 4, fc.Y + 2, &HCC9999, True
  1204.                 Case 6 'Netscape
  1205.                     Call DrawCaption(2)
  1206.                     DrawFrame cShadow, ShiftColor(cLight, &H8), cShadow, ShiftColor(cLight, &H8), False
  1207.                     Call DrawFocusR
  1208.                 Case 7, 8, 12 'Flat buttons
  1209.                     Call DrawCaption(2)
  1210.                     If MyButtonType = [3D Hover] Then
  1211.                         DrawFrame cDarkShadow, cHighLight, cShadow, cLight, False, False
  1212.                     Else
  1213.                         DrawFrame cShadow, cHighLight, 0, 0, False, True
  1214.                     End If
  1215.                     Call DrawFocusR
  1216.                 Case 9 'Office XP
  1217.                     If isOver Then DrawRectangle 0, 0, Wi, He, Abs(MyColorType = 2) * ShiftColor(OXPf, -&H20) + Abs(MyColorType <> 2) * ShiftColorOXP(OXPb, &H80)
  1218.                     Call DrawCaption(2)
  1219.                     DrawRectangle 0, 0, Wi, He, OXPb, True
  1220.                     Call DrawFocusR
  1221.                 Case 11 'transparent
  1222.                     BitBlt hdc, 0, 0, Wi, He, pDC, 0, 0, vbSrcCopy
  1223.                     Call DrawCaption(2)
  1224.                     Call DrawFocusR
  1225.                 Case 13 'Oval
  1226.                     DrawEllipse 0, 0, Wi, He, cDarkShadow, ShiftColor(cFace, -&H20)
  1227.                     Call DrawCaption(2)
  1228.                 Case 14 'KDE 2
  1229.                     DrawRectangle 1, 1, Wi, He, ShiftColor(cFace, -&H9)
  1230.                     DrawRectangle 0, 0, Wi, He, ShiftColor(cShadow, -&H30), True
  1231.                     DrawLine 2, He - 2, Wi - 2, He - 2, cHighLight
  1232.                     DrawLine Wi - 2, 2, Wi - 2, He - 1, cHighLight
  1233.                     Call DrawCaption(7)
  1234.                     Call DrawFocusR
  1235.                 End Select
  1236.                 Call DrawPictures(1)
  1237.             End If
  1238.         Else
  1239.             '#~#~#~#~#~# DISABLED STATUS #~#~#~#~#~#
  1240.             Select Case MyButtonType
  1241.             Case 1 'Windows 16-bit
  1242.                 Call DrawCaption(3)
  1243.                 DrawFrame cHighLight, cShadow, cHighLight, cShadow, True
  1244.                 DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1245.             Case 2 'Windows 32-bit
  1246.                 Call DrawCaption(3)
  1247.                 DrawFrame cHighLight, cDarkShadow, cLight, cShadow, False
  1248.             Case 3 'Windows XP
  1249.                 DrawRectangle 0, 0, Wi, He, ShiftColor(XPFace, -&H18, True)
  1250.                 Call DrawCaption(5)
  1251.                 DrawRectangle 0, 0, Wi, He, ShiftColor(XPFace, -&H54, True), True
  1252.                 mSetPixel 1, 1, ShiftColor(XPFace, -&H48, True)
  1253.                 mSetPixel 1, He - 2, ShiftColor(XPFace, -&H48, True)
  1254.                 mSetPixel Wi - 2, 1, ShiftColor(XPFace, -&H48, True)
  1255.                 mSetPixel Wi - 2, He - 2, ShiftColor(XPFace, -&H48, True)
  1256.             Case 4 'Mac
  1257.                 DrawRectangle 1, 1, Wi - 2, He - 2, cLight
  1258.                 Call DrawCaption(3)
  1259.                 DrawRectangle 0, 0, Wi, He, cDarkShadow, True
  1260.                 mSetPixel 1, 1, cDarkShadow
  1261.                 mSetPixel 1, He - 2, cDarkShadow
  1262.                 mSetPixel Wi - 2, 1, cDarkShadow
  1263.                 mSetPixel Wi - 2, He - 2, cDarkShadow
  1264.                 DrawLine 1, 2, 2, 0, cFace
  1265.                 DrawLine 3, 2, Wi - 3, 2, cHighLight
  1266.                 DrawLine 2, 2, 2, He - 3, cHighLight
  1267.                 mSetPixel 3, 3, cHighLight
  1268.                 DrawLine Wi - 3, 1, Wi - 3, He - 3, cFace
  1269.                 DrawLine 1, He - 3, Wi - 3, He - 3, cFace
  1270.                 mSetPixel Wi - 4, He - 4, cFace
  1271.                 DrawLine Wi - 2, 2, Wi - 2, He - 2, cShadow
  1272.                 DrawLine 2, He - 2, Wi - 2, He - 2, cShadow
  1273.                 mSetPixel Wi - 3, He - 3, cShadow
  1274.             Case 5 'Java
  1275.                 Call DrawCaption(4)
  1276.                 DrawRectangle 0, 0, Wi, He, cShadow, True
  1277.             Case 6 'Netscape
  1278.                 Call DrawCaption(4)
  1279.                 DrawFrame ShiftColor(cLight, &H8), cShadow, ShiftColor(cLight, &H8), cShadow, False
  1280.             Case 7, 8, 12, 13 'Flat buttons
  1281.                 Call DrawCaption(3)
  1282.                 If MyButtonType = [Simple Flat] Then DrawFrame cHighLight, cShadow, 0, 0, False, True
  1283.             Case 9 'Office XP
  1284.                 Call DrawCaption(4)
  1285.             Case 11 'transparent
  1286.                 BitBlt hdc, 0, 0, Wi, He, pDC, 0, 0, vbSrcCopy
  1287.                 Call DrawCaption(3)
  1288.             Case 14 'KDE 2
  1289.                 stepXP1 = 58 / He
  1290.                 For i = 1 To He
  1291.                     DrawLine 0, i, Wi, i, ShiftColor(cHighLight, -stepXP1 * i)
  1292.                 Next i
  1293.                 DrawRectangle 0, 0, Wi, He, ShiftColor(cShadow, -&H32), True
  1294.                 DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cFace, -&H9), True
  1295.                 DrawRectangle 2, 2, Wi - 4, 2, cHighLight
  1296.                 DrawRectangle 2, 4, 2, He - 6, cHighLight
  1297.                 Call DrawCaption(6)
  1298.             End Select
  1299.             Call DrawPictures(2)
  1300.         End If
  1301.     End With
  1302.  
  1303.     If isOver And MyColorType = Custom Then BackC = tempCol: SetColors
  1304.  
  1305. End Sub
  1306.  
  1307. Private Sub DrawRectangle(ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As Long, Optional OnlyBorder As Boolean = False)
  1308.  
  1309. 'this is my custom function to draw rectangles and frames
  1310. 'it's faster and smoother than using the line method
  1311.  
  1312. Dim bRECT As RECT
  1313. Dim hBrush As Long
  1314.  
  1315.     bRECT.Left = X
  1316.     bRECT.Top = Y
  1317.     bRECT.Right = X + Width
  1318.     bRECT.Bottom = Y + Height
  1319.  
  1320.     hBrush = CreateSolidBrush(Color)
  1321.  
  1322.     If OnlyBorder Then
  1323.         FrameRect UserControl.hdc, bRECT, hBrush
  1324.     Else
  1325.         FillRect UserControl.hdc, bRECT, hBrush
  1326.     End If
  1327.  
  1328.     DeleteObject hBrush
  1329.  
  1330. End Sub
  1331.  
  1332. Private Sub DrawEllipse(ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal BorderColor As Long, ByVal FillColor As Long)
  1333.  
  1334. Dim pBrush As Long, pPen As Long
  1335.  
  1336.     pBrush = SelectObject(hdc, CreateSolidBrush(FillColor))
  1337.     pPen = SelectObject(hdc, CreatePen(PS_SOLID, 2, BorderColor))
  1338.  
  1339.     Call Ellipse(hdc, X, Y, X + Width, Y + Height)
  1340.  
  1341.     Call DeleteObject(SelectObject(hdc, pBrush))
  1342.     Call DeleteObject(SelectObject(hdc, pPen))
  1343.  
  1344. End Sub
  1345.  
  1346. Private Sub DrawLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As Long)
  1347.  
  1348. 'a fast way to draw lines
  1349.  
  1350. Dim pt As POINTAPI
  1351. Dim oldPen As Long, hPen As Long
  1352.  
  1353.     With UserControl
  1354.         hPen = CreatePen(PS_SOLID, 1, Color)
  1355.         oldPen = SelectObject(.hdc, hPen)
  1356.  
  1357.         MoveToEx .hdc, X1, Y1, pt
  1358.         LineTo .hdc, X2, Y2
  1359.  
  1360.         SelectObject .hdc, oldPen
  1361.         DeleteObject hPen
  1362.     End With
  1363.  
  1364. End Sub
  1365.  
  1366. Private Sub DrawFrame(ByVal ColHigh As Long, ByVal ColDark As Long, ByVal ColLight As Long, ByVal ColShadow As Long, ByVal ExtraOffset As Boolean, Optional ByVal Flat As Boolean = False)
  1367.  
  1368. 'a very fast way to draw windows-like frames
  1369.  
  1370. Dim pt As POINTAPI
  1371. Dim frHe As Long, frWi As Long, frXtra As Long
  1372.  
  1373.     frHe = He - 1 + ExtraOffset: frWi = Wi - 1 + ExtraOffset: frXtra = Abs(ExtraOffset)
  1374.  
  1375.     With UserControl
  1376.         Call DeleteObject(SelectObject(.hdc, CreatePen(PS_SOLID, 1, ColHigh)))
  1377.         '=============================
  1378.         MoveToEx .hdc, frXtra, frHe, pt
  1379.         LineTo .hdc, frXtra, frXtra
  1380.         LineTo .hdc, frWi, frXtra
  1381.         '=============================
  1382.         Call DeleteObject(SelectObject(.hdc, CreatePen(PS_SOLID, 1, ColDark)))
  1383.         '=============================
  1384.         LineTo .hdc, frWi, frHe
  1385.         LineTo .hdc, frXtra - 1, frHe
  1386.         MoveToEx .hdc, frXtra + 1, frHe - 1, pt
  1387.         If Flat Then Exit Sub
  1388.         '=============================
  1389.         Call DeleteObject(SelectObject(.hdc, CreatePen(PS_SOLID, 1, ColLight)))
  1390.         '=============================
  1391.         LineTo .hdc, frXtra + 1, frXtra + 1
  1392.         LineTo .hdc, frWi - 1, frXtra + 1
  1393.         '=============================
  1394.         Call DeleteObject(SelectObject(.hdc, CreatePen(PS_SOLID, 1, ColShadow)))
  1395.         '=============================
  1396.         LineTo .hdc, frWi - 1, frHe - 1
  1397.         LineTo .hdc, frXtra, frHe - 1
  1398.     End With
  1399.  
  1400. End Sub
  1401.  
  1402. Private Sub mSetPixel(ByVal X As Long, ByVal Y As Long, ByVal Color As Long)
  1403.  
  1404.     Call SetPixel(UserControl.hdc, X, Y, Color)
  1405.  
  1406. End Sub
  1407.  
  1408. Private Sub DrawFocusR()
  1409.  
  1410.     If showFocusR And HasFocus Then
  1411.         SetTextColor UserControl.hdc, cText
  1412.         DrawFocusRect UserControl.hdc, rc3
  1413.     End If
  1414.  
  1415. End Sub
  1416.  
  1417. Private Sub SetColors()
  1418.  
  1419. 'this function sets the colors taken as a base to build
  1420. 'all the other colors and styles.
  1421.  
  1422.     If MyColorType = Custom Then
  1423.         cFace = ConvertFromSystemColor(BackC)
  1424.         cFaceO = ConvertFromSystemColor(BackO)
  1425.         cText = ConvertFromSystemColor(ForeC)
  1426.         cTextO = ConvertFromSystemColor(ForeO)
  1427.         cShadow = ShiftColor(cFace, -&H40)
  1428.         cLight = ShiftColor(cFace, &H1F)
  1429.         cHighLight = ShiftColor(cFace, &H2F) 'it should be 3F but it looks too lighter
  1430.         cDarkShadow = ShiftColor(cFace, -&HC0)
  1431.         OXPb = ShiftColor(cFace, -&H80)
  1432.         OXPf = cFace
  1433.     ElseIf MyColorType = [Force Standard] Then
  1434.         cFace = &HC0C0C0
  1435.         cFaceO = cFace
  1436.         cShadow = &H808080
  1437.         cLight = &HDFDFDF
  1438.         cDarkShadow = &H0
  1439.         cHighLight = &HFFFFFF
  1440.         cText = &H0
  1441.         cTextO = cText
  1442.         OXPb = &H800000
  1443.         OXPf = &HD1ADAD
  1444.     ElseIf MyColorType = [Use Container] Then
  1445.         cFace = GetBkColor(GetDC(GetParent(hwnd)))
  1446.         cFaceO = cFace
  1447.         cText = GetTextColor(GetDC(GetParent(hwnd)))
  1448.         cTextO = cText
  1449.         cShadow = ShiftColor(cFace, -&H40)
  1450.         cLight = ShiftColor(cFace, &H1F)
  1451.         cHighLight = ShiftColor(cFace, &H2F)
  1452.         cDarkShadow = ShiftColor(cFace, -&HC0)
  1453.         OXPb = GetSysColor(COLOR_HIGHLIGHT)
  1454.         OXPf = ShiftColorOXP(OXPb)
  1455.     Else
  1456.         'if MyColorType is 1 or has not been set then use windows colors
  1457.         cFace = GetSysColor(COLOR_BTNFACE)
  1458.         cFaceO = cFace
  1459.         cShadow = GetSysColor(COLOR_BTNSHADOW)
  1460.         cLight = GetSysColor(COLOR_BTNLIGHT)
  1461.         cDarkShadow = GetSysColor(COLOR_BTNDKSHADOW)
  1462.         cHighLight = GetSysColor(COLOR_BTNHIGHLIGHT)
  1463.         cText = GetSysColor(COLOR_BTNTEXT)
  1464.         cTextO = cText
  1465.         OXPb = GetSysColor(COLOR_HIGHLIGHT)
  1466.         OXPf = ShiftColorOXP(OXPb)
  1467.     End If
  1468.     cMask = ConvertFromSystemColor(MaskC)
  1469.     XPFace = ShiftColor(cFace, &H30, MyButtonType = [Windows XP])
  1470.  
  1471. End Sub
  1472.  
  1473. Private Sub MakeRegion()
  1474.  
  1475. 'this function creates the regions to "cut" the UserControl
  1476. 'so it will be transparent in certain areas
  1477.  
  1478. Dim rgn1 As Long, rgn2 As Long
  1479.  
  1480.     rgnNorm = CreateRectRgn(0, 0, Wi, He)
  1481.     rgn2 = CreateRectRgn(0, 0, 0, 0)
  1482.  
  1483.     Select Case MyButtonType
  1484.     Case 1, 5, 14 'Windows 16-bit, Java & KDE 2
  1485.         rgn1 = CreateRectRgn(0, He, 1, He - 1)
  1486.         CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  1487.         DeleteObject rgn1
  1488.         rgn1 = CreateRectRgn(Wi, 0, Wi - 1, 1)
  1489.         CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  1490.         DeleteObject rgn1
  1491.         If MyButtonType <> 5 Then  'the above was common code
  1492.             rgn1 = CreateRectRgn(0, 0, 1, 1)
  1493.             CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  1494.             DeleteObject rgn1
  1495.             rgn1 = CreateRectRgn(Wi, He, Wi - 1, He - 1)
  1496.             CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  1497.             DeleteObject rgn1
  1498.         End If
  1499.     Case 3, 4 'Windows XP and Mac
  1500.         rgn1 = CreateRectRgn(0, 0, 2, 1)
  1501.         CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  1502.         DeleteObject rgn1
  1503.         rgn1 = CreateRectRgn(0, He, 2, He - 1)
  1504.         CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  1505.         DeleteObject rgn1
  1506.         rgn1 = CreateRectRgn(Wi, 0, Wi - 2, 1)
  1507.         CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  1508.         DeleteObject rgn1
  1509.         rgn1 = CreateRectRgn(Wi, He, Wi - 2, He - 1)
  1510.         CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  1511.         DeleteObject rgn1
  1512.         rgn1 = CreateRectRgn(0, 1, 1, 2)
  1513.         CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  1514.         DeleteObject rgn1
  1515.         rgn1 = CreateRectRgn(0, He - 1, 1, He - 2)
  1516.         CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  1517.         DeleteObject rgn1
  1518.         rgn1 = CreateRectRgn(Wi, 1, Wi - 1, 2)
  1519.         CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  1520.         DeleteObject rgn1
  1521.         rgn1 = CreateRectRgn(Wi, He - 1, Wi - 1, He - 2)
  1522.         CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  1523.         DeleteObject rgn1
  1524.     Case 13
  1525.         DeleteObject rgnNorm
  1526.         rgnNorm = CreateEllipticRgn(0, 0, Wi, He)
  1527.     End Select
  1528.  
  1529.     DeleteObject rgn2
  1530.  
  1531. End Sub
  1532.  
  1533. Private Sub SetAccessKeys()
  1534.  
  1535. 'this is a TRUE access keys parser
  1536. 'the basic rule is that if an ampersand is followed by another,
  1537. '  a single ampersand is drawn and this is not the access key.
  1538. '  So we continue searching for another possible access key.
  1539.  
  1540. '   I only do a second pass because no one writes text like "Me & them & everyone"
  1541. '   so the caption prop should be "Me && them && &everyone", this is rubbish and a
  1542. '   search like this would only waste time
  1543.  
  1544. Dim ampersandPos As Long
  1545.  
  1546.     'we first clear the AccessKeys property, and will be filled if one is found
  1547.     UserControl.AccessKeys = ""
  1548.  
  1549.     If Len(elTex) > 1 Then
  1550.         ampersandPos = InStr(1, elTex, "&", vbTextCompare)
  1551.         If (ampersandPos < Len(elTex)) And (ampersandPos > 0) Then
  1552.             If Mid$(elTex, ampersandPos + 1, 1) <> "&" Then 'if text is sonething like && then no access key should be assigned, so continue searching
  1553.                 UserControl.AccessKeys = LCase$(Mid$(elTex, ampersandPos + 1, 1))
  1554.             Else 'do only a second pass to find another ampersand character
  1555.                 ampersandPos = InStr(ampersandPos + 2, elTex, "&", vbTextCompare)
  1556.                 If Mid$(elTex, ampersandPos + 1, 1) <> "&" Then
  1557.                     UserControl.AccessKeys = LCase$(Mid$(elTex, ampersandPos + 1, 1))
  1558.                 End If
  1559.             End If
  1560.         End If
  1561.     End If
  1562.  
  1563. End Sub
  1564.  
  1565. Private Function ShiftColor(ByVal Color As Long, ByVal Value As Long, Optional isXP As Boolean = False) As Long
  1566.  
  1567. 'this function will add or remove a certain color
  1568. 'quantity and return the result
  1569.  
  1570. Dim Red As Long, Blue As Long, Green As Long
  1571.  
  1572.     'this is just a tricky way to do it and will result in weird colors for WinXP and KDE2
  1573.     If isSoft Then Value = Value \ 2
  1574.  
  1575.     If Not isXP Then 'for XP button i use a work-aroud that works fine
  1576.         Blue = ((Color \ &H10000) Mod &H100) + Value
  1577.     Else
  1578.         Blue = ((Color \ &H10000) Mod &H100)
  1579.         Blue = Blue + ((Blue * Value) \ &HC0)
  1580.     End If
  1581.     Green = ((Color \ &H100) Mod &H100) + Value
  1582.     Red = (Color And &HFF) + Value
  1583.  
  1584.     'a bit of optimization done here, values will overflow a
  1585.     ' byte only in one direction... eg: if we added 32 to our
  1586.     ' color, then only a > 255 overflow can occurr.
  1587.     If Value > 0 Then
  1588.         If Red > 255 Then Red = 255
  1589.         If Green > 255 Then Green = 255
  1590.         If Blue > 255 Then Blue = 255
  1591.     ElseIf Value < 0 Then
  1592.         If Red < 0 Then Red = 0
  1593.         If Green < 0 Then Green = 0
  1594.         If Blue < 0 Then Blue = 0
  1595.     End If
  1596.  
  1597.     'more optimization by replacing the RGB function by its correspondent calculation
  1598.     ShiftColor = Red + 256& * Green + 65536 * Blue
  1599.  
  1600. End Function
  1601.  
  1602. Private Function ShiftColorOXP(ByVal theColor As Long, Optional ByVal Base As Long = &HB0) As Long
  1603.  
  1604. Dim Red As Long, Blue As Long, Green As Long
  1605. Dim Delta As Long
  1606.  
  1607.     Blue = ((theColor \ &H10000) Mod &H100)
  1608.     Green = ((theColor \ &H100) Mod &H100)
  1609.     Red = (theColor And &HFF)
  1610.     Delta = &HFF - Base
  1611.  
  1612.     Blue = Base + Blue * Delta \ &HFF
  1613.     Green = Base + Green * Delta \ &HFF
  1614.     Red = Base + Red * Delta \ &HFF
  1615.  
  1616.     If Red > 255 Then Red = 255
  1617.     If Green > 255 Then Green = 255
  1618.     If Blue > 255 Then Blue = 255
  1619.  
  1620.     ShiftColorOXP = Red + 256& * Green + 65536 * Blue
  1621.  
  1622. End Function
  1623.  
  1624. Private Sub CalcTextRects()
  1625.  
  1626. 'this sub will calculate the rects required to draw the text
  1627.  
  1628.     Select Case PicPosition
  1629.     Case 0
  1630.         rc2.Left = 1 + picSZ.X: rc2.Right = Wi - 2: rc2.Top = 1: rc2.Bottom = He - 2
  1631.     Case 1
  1632.         rc2.Left = 1: rc2.Right = Wi - 2 - picSZ.X: rc2.Top = 1: rc2.Bottom = He - 2
  1633.     Case 2
  1634.         rc2.Left = 1: rc2.Right = Wi - 2: rc2.Top = 1 + picSZ.Y: rc2.Bottom = He - 2
  1635.     Case 3
  1636.         rc2.Left = 1: rc2.Right = Wi - 2: rc2.Top = 1: rc2.Bottom = He - 2 - picSZ.Y
  1637.     Case 4
  1638.         rc2.Left = 1: rc2.Right = Wi - 2: rc2.Top = 1: rc2.Bottom = He - 2
  1639.     End Select
  1640.     DrawText UserControl.hdc, elTex, Len(elTex), rc2, DT_CALCRECT Or DT_WORDBREAK
  1641.     CopyRect rc, rc2: fc.X = rc.Right - rc.Left: fc.Y = rc.Bottom - rc.Top
  1642.     Select Case PicPosition
  1643.     Case 0, 2
  1644.         OffsetRect rc, (Wi - rc.Right) \ 2, (He - rc.Bottom) \ 2
  1645.     Case 1
  1646.         OffsetRect rc, (Wi - rc.Right - picSZ.X - 4) \ 2, (He - rc.Bottom) \ 2
  1647.     Case 3
  1648.         OffsetRect rc, (Wi - rc.Right) \ 2, (He - rc.Bottom - picSZ.Y - 4) \ 2
  1649.     Case 4
  1650.         OffsetRect rc, (Wi - rc.Right) \ 2, (He - rc.Bottom) \ 2
  1651.     End Select
  1652.     CopyRect rc2, rc: OffsetRect rc2, 1, 1
  1653.  
  1654.     Call CalcPicPos 'once we have the text position we are able to calculate the pic position
  1655.  
  1656. End Sub
  1657.  
  1658. Public Sub DisableRefresh()
  1659.  
  1660. 'this is for fast button editing, once you disable the refresh,
  1661. ' you can change every prop without triggering the drawing methods.
  1662. ' once you are done, you call Refresh.
  1663.  
  1664.     isShown = False
  1665.  
  1666. End Sub
  1667.  
  1668. Public Sub Refresh()
  1669.  
  1670.     If MyButtonType = 11 Then Call GetParentPic
  1671.     Call SetColors
  1672.     Call CalcTextRects
  1673.     isShown = True
  1674.     Call Redraw(lastStat, True)
  1675.  
  1676. End Sub
  1677.  
  1678. Private Function ConvertFromSystemColor(ByVal theColor As Long) As Long
  1679.  
  1680.     Call OleTranslateColor(theColor, 0, ConvertFromSystemColor)
  1681.  
  1682. End Function
  1683.  
  1684. Private Sub DrawCaption(ByVal State As Byte)
  1685.  
  1686. 'this code is commonly shared through all the buttons so
  1687. ' i took it and put it toghether here for easier readability
  1688. ' of the code, and to cut-down disk size.
  1689.  
  1690.     captOpt = State
  1691.  
  1692.     With UserControl
  1693.         Select Case State 'in this select case, we only change the text color and draw only text that needs rc2, at the end, text that uses rc will be drawn
  1694.         Case 0 'normal caption
  1695.             txtFX rc
  1696.             SetTextColor .hdc, cText
  1697.         Case 1 'hover caption
  1698.             txtFX rc
  1699.             SetTextColor .hdc, cTextO
  1700.         Case 2 'down caption
  1701.             txtFX rc2
  1702.             If MyButtonType = Mac Then SetTextColor .hdc, cLight Else SetTextColor .hdc, cTextO
  1703.             DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTER
  1704.         Case 3 'disabled embossed caption
  1705.             SetTextColor .hdc, cHighLight
  1706.             DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTER
  1707.             SetTextColor .hdc, cShadow
  1708.         Case 4 'disabled grey caption
  1709.             SetTextColor .hdc, cShadow
  1710.         Case 5 'WinXP disabled caption
  1711.             SetTextColor .hdc, ShiftColor(XPFace, -&H68, True)
  1712.         Case 6 'KDE 2 disabled
  1713.             SetTextColor .hdc, cHighLight
  1714.             DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTER
  1715.             SetTextColor .hdc, cFace
  1716.         Case 7 'KDE 2 down
  1717.             SetTextColor .hdc, ShiftColor(cShadow, -&H32)
  1718.             DrawText .hdc, elTex, Len(elTex), rc2, DT_CENTER
  1719.             SetTextColor .hdc, cHighLight
  1720.         End Select
  1721.         'we now draw the text that is common in all the captions
  1722.         If State <> 2 Then DrawText .hdc, elTex, Len(elTex), rc, DT_CENTER
  1723.     End With
  1724.  
  1725. End Sub
  1726.  
  1727. Private Sub DrawPictures(ByVal State As Byte)
  1728.  
  1729.     If picNormal Is Nothing Then Exit Sub 'check if there is a main picture, if not then exit
  1730.  
  1731.     With UserControl
  1732.         Select Case State
  1733.         Case 0 'normal & hover
  1734.             If Not isOver Then
  1735.                 Call DoFX(0, ub 'check    cFaceO = cFace
  1736.       ), if notCall OleTran    End If
  1737.    
  1738. Privatop = C  Ene)oate the rects required toen Fect Then
  1739.                    End If
  1740.    
  1741. Privat
  1742.     Red = (Color And &HFF) + Value
  1743.  
  1744.     'a bit of optimiza End If
  1745.    
  1746. Xr XP           F) +odow,ll OleTranttom) \ 2
  1747.     Case 1
  1748.         OffsetRec
  1749. Privatop = C  Ene)oatcaptions
  1750.   s Dec
  1751. Pri's a mai    cS 2
  1752.   )
  1753. ct Thne)oatvatop =tanttt 2 disabled
  1754. 2
  1755.      
  1756. ct Thne)oatvatop 0, i, Wic .hdc, cShaF=x   Call DrawPictures(1)
  1757.             End IflF EnCHlindov
  1758.               olor \ &H10000)Bosition
  1759. 3      OrawRecta = c1)
  1760.             ysi, Wic .hdc,IFF
  1761.             DeleteObject rgn1
  1762.   d bW1 cShadow
  1763. E
  1764.         Select Case State
  1765.      a   DeleteObjeck  i d bW1   (elTex), rc,   rgase State
  1766.      a  Xvatop =tanttt 2 disable          Call Drt Sub 'check if the As Long =teft = 1: rc2.Right = Wi - 2: rc2.Top = 1: rc2.Bottom = He - 2
  1767.     End Select
  1768.     DrawText UserControl.hdc, elTex, i, WMce, -&u1)
  1769.             ysi, Wic .hdc,IFF
  1770.             Delet.Top = 1BrCo        OffsetRec
  1771. Privatop = C  Ene)Pfc.X = rc.Right - rc.Left: , e= ((th
  1772. PrDraw rc.Right dSub 'checaw rc.R2.TopY: rc2.Bo.TopY: rc2.Blor(XPFace, -&Hoc.Right dSub 'checar0i  txtFX rc2
  1773.   Wr  Case 4
  1774.    - 4) \d If
  1775.    
  1776. Privatop = C u
  1777.    
  1778. Privatop = C u
  1779.    
  1780. Privatop.ht d    ShiftCol0 OleTran lTex, Lee)Pfc.X = rc.Right - rc.Left: , e= ((th
  1781. PrDraw rc.Right dSub    End Select
  1782.     DrawText Userc
  1783. Pri'ivang =teft = 1: rc2.Right 6i, He,*SWic  SellCo2: rc2.To'Select Case Sta3Dra[4x, LecFaceO = cFace
  1784.       'ricNcAs Long, ByVal 
  1785.    
  1786. Privatop.ht d    Shily change the t t(XPFace,(eTranslateChadowbject rgd)Pfc.X -&HC0)
  1787.  Copy= ((th
  1788.  Case 9 'Office XP
  1789.       arch like this would only waste time
  1790.  
  1791. Dim ampersandPos As Longrc.L ((-SHe 1, H Case 4
  1792.   wers3C>0'ricNcAs Long, ByVal 
  1793.    
  1794. dP
  1795. ct Thne) rc.Rightor(XPFace) rc.Rightor(XPFace) rc.Rightor(XPFace) rc.RightovX pro
  1796.    
  1797. Long' ampersandPos Ae) rc.RigeO F((-SHe XPFace) rc.Rightor(XPFace) rc.RightovX pro
  1798.    
  1799. Long' ampersandPos Ae) rc.RigeO F((-SHe XFi - 2F En    TER             DrawFram Use XFi select case, we only change thFace) rc.RightovX pro
  1800.    
  1801. Long' ampersandPos Ae) rc.RigeO F((Dim ReceODisX+Dim ReceODisXe thFace) rc.Rightx, LecFaDE2
  1802.     Ihe t t(XPFace,(eTranslm, rc2, DT_CEN 6i, HO F((-SHe XF, DT_CEN 6i, HO F((-erst    If isOverampersandPos Ae) rc.RigeO F((-SHe XFi - 2F En    TE rc: OffsetRect rc2, 1, 1
  1803.  
  1804.     Call CalcPicPos 'once we have the tex          m As i cFa6uS cFaceex    To'Select Case Sta3Dra[4x, LecFaceB, DT_CENTER
  1805.  
  1806.  
  1807.  
  1808.  
  1809.  
  1810.  
  1811.  
  1812.  
  1813.  
  1814.  
  1815.  
  1816.  
  1817.  
  1818.  
  1819.  
  1820.  
  1821.  
  1822.  
  1823.  
  1824.  
  1825.  
  1826.  
  1827.  
  1828.  
  1829.  
  1830.  
  1831.  
  1832.  
  1833.  
  1834.  
  1835.  
  1836.  
  1837.  
  1838.  
  1839.  
  1840.  
  1841.  
  1842.  
  1843.  
  1844.  
  1845.  
  1846.  
  1847.  
  1848.  
  1849.  
  1850.  
  1851.  
  1852.  
  1853.  
  1854.  
  1855.  
  1856.  
  1857.  
  1858.  
  1859.  
  1860.  
  1861.  
  1862.  
  1863.  
  1864. alcPicPos 'asic rule is that if an ammN ERcDEetRect rc2, 1, 1Sub
  1865.  
  1866. Private Sub nslm, rc2, DT_CEN 6i, HDunctie, ShiftColor(XPFace, --&u1)
  1867.        --&u1)
  1868.     2yrc2.fsetRrawText Userc
  1869. Pri'ivang TER
  1870.  
  1871.  
  1872.  
  1873.  
  1874.  
  1875.  
  1876.  
  1877.  
  1878.  
  1879.  
  1880.  
  1881.  
  1882.  
  1883.  
  1884. Aave the tex          m As     Bent in certain ar_ tex          m As i-ivang TO ReceODisXeger XP button i use a work-aroud that work i use ShiftColor(OXPf, -&H20) + Abs(MyC 6i, HDunctie, ShiftColor(rPAos 'asic rule is that if an ammN ERcDEetRect(en
  1885.         cFace = &Hk-aroudd ub 'chOXPf, -fsetRra1, DT_rule is SeC
  1886.  
  1887.  
  1888.  
  1889. rc.RigeOObjeck  i d Fpngle 2, 4, 2, He -2, Fice XPZRight dSube teght dSube teght dSube teght dSc .hdex, i, he buttoig   rule is S- 3, Wi - 4, He -pic teght dSc .hdex, i, he buttoig   rule 3DawText Userc
  1890. Pri'ivang y   rule 3DawTeBackC)
  1891.         cFac$ 3DawTt3ange everame cHighLight, cDarkShadow, cLight, cShadow, Fs1Wi i'c2.Left = 1 + picSZ.X: rc2.RColor(rPAos 'asic rule is tShadowthe AsA1ork i use ShiftColor(OXPuttoig   rule is S- 3, Wi - 4, He -pic teg=G  ysi, W have the tex          m A,irule  base to build
  1892.    nCaptionHr(ampersandPos + 2, (-          D 0 '       EngHe -  Wi - 4,1en isShown = False: prevBTt3ange everase: prevBTt3ange everase: prevBTt3ange<> 2 Then DrawTexmN ERcDEetR'dteght dSuGe(eTrang O F((-SHe -&H20, B D 0 '       EngHe -  Wi - 4,1en igHe -  Wi 1 = CreateRectRgn(Wi, He, Wi - 1, He - 1)
  1893.    N ERcDEetR'dteght dS0Dd Select
  1894. #@#@#@etRect(en
  1895.         cFace = &Hk-aroudd aptionHr(ampersandPos +g thd aptionHreck  i d Fpngle 2, 4, 2, He -2, Fice XPZRi - 3,    Case 1
  1896.          cFace = &Hk-aroudd CassssSenNor
  1897.               = ShiftHe TER
  1898.      i, w, cLmsaSelect
  1899.         'we now draw the text that is common in all traw th        E 2 disabled
  1900.            A w, ceHreck  i d FpnglA w, ceHreck  i d FpnglA w, ceHreck  i d FpnglAion (rs
  1901.      aaud that workivatop.ht d    ShiftCol0 :E, -&H. sooonal B
  1902.  nHr(ampersandPos +g thd apti draw  d FpnglA w, c           XP bu'we ncLmsaSe      Call DoFXY: rcS, i, he buttoig Tran lTex,SP     To HeChadowb===lor \ &H1wO.
  1903.  
  1904.  
  1905.  
  1906.  
  1907. a7e=n BTnex,S. sooona          4,1en iFpnglAion (rs    m Asc           XP bu'we ncLmsaSe   LmsaSeleoona    etRec
  1908. Privatop = C  Ene'we ncLmhisnHr(amB HeChadowbos 'once wnEb)
  1909.   ne Wi - tDRight dSuen iFpnglAf         ex, ampersandPos + 1, 1))
  1910.    laccHighLight, -stepXP1 * i)
  1911.                 Next i
  1912.   lText, -stepXP1 * i)E If     OrawRecta A w, c
  1913.  
  1914. a7e=n BTnex,S. sooona  trooig ByVs ' a3RtColor(OX((th
  1915. Plor sssSenNor
  1916.               = ' fw, c w, c       Tlo buitText, (      etTextC  lText, -stepXP1 * i)E If   Color(OX((th
  1917. Plor sssSe c      , c w, c-stetepXP1 * i    unType SXwRectaf iase 9 'Office XP
  1918.       arch like this would 3  OXPb = GetSysColdc, cFteoonpXP- 9 'Office XP' fw, c w, c       Tlo bu    d    ShiftCol0 o5 'WinsssSene   To Hould 3  OXPb = GetSysColdce XP' t, ( ShiftC OXPb ===================================preB\ 2
  1919.  
  1920.     If Not isXP t rgn1
  1921.      thd aptionHrectCol0 :E, -&H- 2=================
  1922.   ce XP
  1923. Oo-&H. sooonal B
  1924.  nHr(ampat workivatCnd &HFCase
  1925. '   so2.TopY: rc2.Bo.TopYLong
  1926. ===============
  1927.    OrawRecta
  1928.    OrawRecta
  1929.    OraeV As L000) Mod &H101nglA w, ceHreck  i d FpnglAion (rs
  1930.      aaud that worHtM
  1931.    OraeV As L000) ModWinssm, rc2, DT_C
  1932. Private Sub nslm, rc2,'n (rs
  1933.      aaud that                   /5                                                                Fse ShiftColor(OXPf, -&H2iu                                    Fse ShiftColor(Oe 0, 0ftColor            
  1934.     Copn  .hd.RigeO (P$e
  1935.   i        XP bu'we ncLms          a6l0uon (rsor            
  1936.     Copn  .hd.RigeO B searching for another poso'Select Case Sta3Dra[4x, LecFaceO = cFace
  1937.       'ricNcAs Lonrearc.Right) \ 2, (He - rc.Bottom -r3.hdc, cTextOe StraeV As PtRgn(or
  1938.    
  1939.  ,onal o-&H.atCnd &buitTe0
  1940.    laccHighIStraeV )
  1941.  r(c          D5     le ampersand is drawn and this is not the acce 2, (He - rc.Bottom -r3.hsdeO (P$ laccH, Shi00) ModWinssm, rc2, DT_C
  1942. Private0, 0, Wi, He)
  1943.     End Selemobd &buiOe 0, 0ftCBottomIBa 
  1944.     Copn  en(eu+ Abs(MyC 6i, HDunctie, 40), True
  1945.                    1 ' (so'Select Case Sta3Dra[4:3i,Sub  (amB Hem1 ' (si       m A,irule  base to build
  1946.    nCaptionHr(ampersandPos + 2, (-          D 0 '       EngH  mc, rc2: faeV As PtRgn(or
  1947.    
  1948. ue to 9siya(e)
  1949.  ooon - ub 'chOXPf,lklsCasesb  i   =i, (-   e
  1950.   t, (or
  1951.    ight, -stepXP1 * i)
  1952.        t, -stepXP10, 0ftCBottomI
  1953.    i DrawRecta m A,iR'dteght dSuGe(e5F EngH  mc Fpngle 2, Sub SetColors()
  1954.  
  1955. 'this functioru,iR'dteght dSuGe, (   SetCIfunctioru,iBottomIFH  mc Fpn (or
  1956.    ight,               t it looks too l Wi, He)
  1957.    X rc
  1958. #@#@#@etRecP t e5F EngH  mc Fpngle 2, Sub SetColors()
  1959.  
  1960. 'this fk0Tlo b i Draw   CombineRgn pXP1 2, He - 2, cShadow
  1961.               S  .hd.i D He - 1, ShiftCols1 2H  mc Fpn (urc.Rightx, Leght dSuGe(e5F EngH  mc Fpngle 2, Sub SetColors()
  1962.  
  1963. 'this functioru,iR'dteght dSuGe, (   SetB
  1964.     ud If'HPos, HeevBcght,               t it looks toooMe) is my custom function to draw rectangles and frames
  1965. 'it's faster and smoother than using theaption(2)XectRgn(Wng, ByVal and smoothn.ledSc .hdeand e acce 2, (He - rc.Braw rectangt 6i, He,A,iR'dteght dSuGe(A1ectBTn 2 Then DrawTexmN Eihis ft 6i, H+Fe, 40), True
  1966.        C5p Sub SetCols functioruA,iR'd        Cswoks too l Wi, He)
  1967.    X rcFetCols functioruA,iR'd        Cswo, 0ftCBottomI
  1968.    i DrawRecta m A,iR'ds Ae) rc.RigeO F((Dim ReceODietSys"PFalse: prevBTtMyColAsc    (Wng, ByVal,iRRRRRRRRRRRRRRRRRevBT           S  .nc,i       Case 1:/Col0 :E, -&H. sooonal BShiftHe TER
  1969.      i, w, cLmsaSelect
  1970.         'we now draw the text th3 = &HB0) As Longo'Se, ByVa 1, 1))
  1971.    4aEnddu rectangles annnnntext    PS_SOLID, 1, Color)B1, He - 2, &H7drc.Braw rectangt 6Hng
  1972.  
  1973. Dim Red As LongTtMy= CreateRectRgn(WieandRGN_DIFF
  1974.         Dele
  1975. Private0, 0, Wi, He)A1ectBTn 2Select
  1976.    n
  1977.     End w, cLighlation
  1978. .Top = 1: rc2.Bottom = He -    End w, cLighlation
  1979. .Top = 1: rc2.Not isXP t rgn1
  1980.      thd aptionHreP t e5F EnbtRecP, cse pi'this fe1iR'dteght dSuGe, (   SetB
  1981.     ud I - 1, Shie pi'this fe1iR'dteght dSuGe, (   SetB
  1982.     ud I - 1, Shie pi'this fe1iR'dteght dSuGe, (   SetB
  1983.     ud I - 1, Shie pi'this fe1i ====I - t
  1984.     Red    ud I - 1, Shie pi'eF        SetTextColor .hdc, cHigheutColor.RigeO B searching for another poso'Select Cas2=I - tlHighe(reck Call DeleteObject(SelectObject(hdc, pPen))
  1985.  
  1986. End Sub
  1987.  
  1988. PricLiyetColsrTyphherct(hb SetCol   = ' fw,iR'(aO F((DirolsrTyphherct(hb SetCyRects
  1989.    w, cLight, 0)DtepXP1 * s functioru,iR'dteght dSungles annnnntexqelect ruA,iR'd        Cswo,ect Cas2=I - tlHighe(rA w, ceHreck  i d FpnglA w, ceH4RBi40)
  1990.         cLigy
  1991.         cLigy
  1992.     PtRgn(orptionHrectCol0 :E, -&H- 2=================Xt ========iceH4RBi4ASmaceO = cFace
  1993.         cShadowq Case==icePrivate2&pXP+tub SetCols functio5r(cHighLight, -stepXP1 * i)
  1994.               how,ll OleTraor)B1, HgroC+tub SetCols functio5r(cHighLight, -stepO FpngleFBi        cLigyN is not the acC, True
  1995.        C5p Sub SetCols functioruA,iR'd        Cswoks too l Wi, He)<an ar3.hsdiC
  1996. Private0, 0, Wi, He)
  1997.     End      Del cFaCols funce) rc.RigeO F((Dim ReceOXectR STAT>ase==i70eckse==icePs is SeC
  1998.  
  1999.  
  2000.  
  2001. rc.RigeOObjeck  i d F    ud I - 1, Shie pi'thisu = (Color And &HFF) klsCasesb  i   =i, (-   e
  2002.   t, (or
  2003.    ight, -stepXP1 * i)eSthis nctio5r(cHighLight, -stepO Fp-&H68, Truht = Wi - 2: rc2.Top = 1 + picSZ.Y: rc2.Bottom = He - 2
  2004.     Casd<an arA w, c          i HDunctie, 40), True
  2005.         DarkShadow FpnglA w, c fun2
  2006.     Cas(en = ((theC- 1, ShiftCols1 2H  mc Fpn (urc.Rightx, Leght dSuGe(e5F EngH  mc Fpngle 2, Sub SetColors(Sub Se2- w, c    D
  2007.  
  2008.  
  2009.  
  2010.  
  2011.  
  2012.  
  2013.  
  2014.  
  2015.  
  2016.  
  2017.  
  2018.  
  2019.  
  2020.  
  2021.  
  2022.  
  2023.  
  2024.  
  2025.  
  2026.  
  2027.  
  2028.  
  2029.  
  2030.  
  2031.  
  2032.  
  2033.  
  2034.  
  2035.  
  2036.  
  2037.  
  2038.  
  2039. alcPicPos 'asic rule is that if an ammN E      C(
  2040.  
  2041.  
  2042.  
  2043.  
  2044.  
  2045. a3Dra2Pri'ig 2, Wi - 2, He - 1, cHis4'32nhie S  .nc,i       Case 1:/Col0 :E,     cS/Col0 :E,     cS/CiroC+tub Se
  2046. alcPi'asic ri(:/Col0 :E,     ac$ 3bu'we ncLmsaSepeu      DeleteObject rgn1
  2047.      Cas, -ssssssssssssssssD,hiftgleFBi   I()A1ectBTn 2Select
  2048.    epeu      DeleteCase 1:igh Cas, -ssssss ule iP - 2, He - ==Xighe(rA w, ceHreck  i d, 1, Wi - 3, He -      colors taken as a base to b He - ==Xighe        Sub Se2- w, c    D
  2049.  
  2050.  
  2051.  
  2052.  
  2053.  
  2054.  
  2055.  
  2056.  
  2057.  
  2058.  
  2059.  
  2060.  
  2061.  
  2062.  
  2063.  
  2064.  
  2065.  
  2066.  
  2067.  
  2068.  
  2069.  
  2070.  
  2071.  
  2072.  
  2073.  
  2074.  
  2075.  
  2076.  
  2077.  
  2078.  
  2079.  
  2080.  
  2081. alcPicPos 'asic rule   SetTextColor .hdc, cHigheutColor.RigeO